home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / prtcs155.zip / QWK.WPL < prev    next >
Text File  |  1994-01-14  |  5KB  |  154 lines
  1. /**/
  2. v="$VER: QWK Wplrx Falcon-SMail QWK Mail Packer and Downloader   Williamson 55.03"
  3. auxdev ="CTDL-AUX:"
  4. qwkcmd ="BBS:bin/smail >CTDL-AUX: <CTDL-AUX:"
  5. qwkcfg ="BBS:smail/smail.cfg"
  6. qwkdir ="ram:"
  7. qwkfile="AMIGAECS.QWK"
  8.  
  9. options results
  10. options failat 20
  11. signal on syntax  
  12. signal on halt
  13. signal on ioerr
  14. signal on break_c
  15. signal on break_d
  16. baseport=GetClip('SHELTER')
  17. logport=lower(baseport)||'wpl'
  18. if ~show("L", "rexxsupport.library") then
  19.     if ~addlib("rexxsupport.library", 0, -30, 0) then exit 20
  20.     script="QWK"
  21.     sv=right(v,5)
  22.     log=show('P','ROOFLOG')
  23.  
  24.     if ~showlist("H",auxdev) then do
  25.         options failat 99999
  26.         ADDRESS COMMAND 'MOUNT 'auxdev' FROM DEVS:MOUNTLIST.AUX'
  27.         options failat 20
  28.     end
  29.     rpath=addslash(dequote(GetClip('REXXDIR')))
  30.     quote='"'
  31.     cr='\r\n'
  32.  
  33. parse arg baud port username
  34.  
  35.     call send(cr||' QWK Server v'sv' on $(host.sitename)'||cr)
  36.  
  37.     call send(cr||' If you have a QWK packet to import, please exit and use the UL')
  38.     call send(cr||' to upload it.  Do you wish to exit and upload a packet?  (Y/n)')
  39.     resp=upper(getstring(60))
  40.     if resp="Y" then exit
  41.  
  42.     call send(cr||' 'username' ,please enter your $(host.sitename) User Number: ')
  43.  
  44.     unumber=getstring(60)
  45.     if fname="" | datatype(unumber) ~= 'NUM' | unumber=1 then do
  46.         call send(cr||'Sorry, your user number is required for QWK access')
  47.         call send(cr||'If you do not know it, you must enter the BBS and ask the sysop'||cr)
  48.         call cleanup()
  49.         exit 0
  50.     end
  51.  
  52.     Call PutLog('Launching QWK Server @ 'baud' bps',10,10)
  53.     call send(cr||' Please note that if you pack any mail, it will be sent')
  54.     call send(cr||' to you automatically via Zmodem AutoDownLoad')
  55.     'Set DOOR TRUE'
  56.     process=word(qwkcmd,1)
  57.     address AREXX rpath'Carrier 'baseport||port process
  58.  
  59.     call delay(50)
  60.     cmd=qwkcmd unumber qwkcfg
  61.     address COMMAND cmd
  62.     'Set DOOR FALSE'
  63.     if exists(qwkdir||qwkfile) then do
  64.         call send(cr||' Ready, be sure Zmodem is your default protocol and AutoDownLoad is ON')
  65.         call send(cr||' By the way, you can upload your QWK reply packet right after your')
  66.         call send(cr||' download is completed.'||cr)
  67.         call delay(50)
  68.         call fxfer() 
  69.     end
  70.     call send(cr||'QWK Server exiting'||cr)
  71. exit 0
  72.  
  73. fxfer:
  74.     'Set inbound' qwkdir
  75.     'Set protocol Zmodem'
  76.     'XprSetup xprzedzap.library "TN,ON,B16,F0,E30,AN,DN,KN,SY,RN,M1024"'
  77.     'SetUpDate "CON:0/$($(line).w_offset)/640/130/QWK Server/AUTO/SCREEN$(pscreen)"'
  78.     'XprSetFile' qwkdir||qwkfile qwkfile 'K'
  79.     'XprSend 'qwkdir||qwkfile
  80.     call send(cr||cr||'$(filestatus): $(cps) CPS ($(cpsp)%) of $(baud) Bps')
  81.     call send(cr||'If you wish to upload a QWk packet, start your transfer now'||cr)
  82.     'XprReceive ""'
  83.     'RexxMsg NY LOGPROC "PutLog $<time> QWK $(protocol) Recv:$(RC)"'
  84.     'XprClose'
  85.     'SetUpDate NULL'
  86. return
  87.  
  88. send:
  89.     'Print' quote||arg(1)||quote
  90.     'Send' quote||arg(1)||quote
  91. return
  92.  
  93. getstring:
  94.     'GetInbound E0 'arg(1)
  95.     'String $(event)'
  96.     if upper(RESULT) = 'CARRIER' then do
  97.         address LOGPROC 'PutLog' logport "$<time> $(line) GRAB 'fname' dropped Carrier"'
  98.         call PutLog('User 'fname' dropped carrier',10,10)
  99.         call cleanup 
  100.         exit
  101.     end;else if upper(RESULT) = 'LOGIN' then do
  102.         'String $(namebuf)'
  103.         x= upper(RESULT) 
  104.     end;else x=""
  105. return x
  106.  
  107. PutLog:  procedure expose log script logport port
  108.     if arg(3) < GetClip('STATUSLEVEL') then say arg(1)
  109.     if arg(2) > GetClip('LOGLEVEL') then return 0
  110.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  111.     else address LOGPROC 'PutLog' logport '"'time() port 'GRAB' arg(1)'"'
  112. return 0
  113.  
  114. addslash:
  115.     curr = arg(1)
  116.     select
  117.         when right(curr, 1) = ":" then nop
  118.         when right(curr, 1) = "/" then nop
  119.             otherwise curr = curr"/"
  120.     end
  121. return curr
  122.  
  123. /* a useful procedure by Walt Sullivan    */
  124. dequote:
  125.     parse arg thing
  126.     parse var thing '"' unq_thing '"'
  127.     if unq_thing ~= "" then return unq_thing
  128. return thing
  129.  
  130. lower:
  131. return(bitor(arg(1),'20'x))
  132.  
  133. cleanup:
  134. return
  135.  
  136.  /*  Error handling */
  137. break_c:
  138. break_d:
  139.     PutLog('User abort',10,10)
  140.     call cleanup
  141.     exit 10
  142.  
  143. /* Miscellaneous utility functions */
  144.  
  145. /* handle references to uninitialized variables by saying which line */
  146. /* and typing the offending line.  */
  147.  
  148. template_oops: 
  149.         parse arg what badline code
  150.         if code ~= "" then  call PutLog("ERR: Line "badline what errortext(code),10,10)
  151.             else call PutLog("ERR: Line" badline what,10,10)
  152.         exit(40)
  153. /**/
  154.